Shareware Grab Bag/Shareware Grab Bag.iso/005/tss15.arc/TSSPROC.PRG

Text File | 1986-06-25 | 15.5 KB | 715 lines

*****************************************************************************
*
* TSSPROC.PRG
* Called by TSS.PRG
* version 1.5   06/25/86
* orign 01/85  A.J. Sieker
* Procedure File for general input/housekeeping
*
* mod 07/85 for clipper
* mod 09/85 for floppy usage
* mod 03/15/86 brow funct, general improvements
* mod 03/25/86 change archive to only backup TSSINPUT.DBF
* mod 04/15/86 data input error trapping with bell and looping
* mod 06/25/86 changed NDX macro usage within the FIELD() function
*              in INITDBF.
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE INPUT

CLEAR
STORE .T. TO DEPT_FLAG,EMP_FLAG,CON_FLAG,CHG_FLAG,DATA
STORE 0 TO TOT_HOURS,ROW,COL,HOURS_IN
STORE ' ' TO DEPT_IN,EMP_IN,CON_IN,EMP_KEY
SELECT A
DO WHILE DEPT_FLAG
   DEPT_IN='      '
   CLEAR
   @ 1,0 SAY 'Time Sheet Data Entry'
   @ 2,0 SAY 'Department   ' GET DEPT_IN PICTURE '999999'
   READ
   IF DEPT_IN=' '
      DEPT_FLAG=.F.
      LOOP
   ELSE
      SELECT D
      SEEK DEPT_IN
      IF EOF()
         SET COLOR TO I
         @ 2,40 SAY DEPT_IN+' NOT IN MASTER FILE'
         SET COLOR TO
         DO WAITKEY
         LOOP
      ELSE
         @ 2,40 SAY NAME
      ENDIF
      SELECT A
   ENDIF
   EMP_FLAG=.T.
   DO WHILE EMP_FLAG
      EMP_IN='    '
      @ 3,0 CLEAR
      @ 3,0 SAY 'Employee No. ' GET EMP_IN PICTURE '9999'
      READ
      IF EMP_IN=' '
         EMP_FLAG=.F.
         LOOP
      ELSE
         SELECT B
         SEEK EMP_IN
         IF EOF()
            SET COLOR TO I
            @ 3,40 SAY EMP_IN+' NOT IN MASTER FILE'
            SET COLOR TO
            DO WAITKEY
            LOOP
         ELSE
            @ 3,40 SAY SPACE(39)
            @ 3,40 SAY TRIM(LAST_NAME)+', '+TRIM(FIRST_NAME)
         ENDIF
         SELECT A
      ENDIF
      CON_FLAG=.T.
      ROW=8
      COL=0
      TOT_HOURS=0
      DATA=.F.
      DO WHILE CON_FLAG
         CON_IN='              '
         HOURS_IN=0.0
         @ 5,0 SAY 'Contract     ' GET CON_IN
         @ 6,0 SAY 'Hours        ' GET HOURS_IN PICTURE '999.9'
         READ
         DO CASE
            CASE CON_IN=' '
                 CON_FLAG=.F.
                 LOOP
            CASE CON_IN='R' .OR. CON_IN='r'
                 IF .NOT. DATA
                    LOOP
                 ENDIF
                 DO REDO
                 LOOP
            CASE CON_IN='D '
                 CON_IN='\DIRECT'
            CASE CON_IN='H '
                 CON_IN='\HOLIDAY'
            CASE CON_IN='I '
                 CON_IN='\INDIRECT'
            CASE CON_IN='O'
                 CON_IN='\OVERHEAD'
            CASE CON_IN='S '
                 CON_IN='\SICK'
            CASE CON_IN='V '
                 CON_IN='\VACATION'
         ENDCASE
         APPEND BLANK
         REPL DEPT WITH DEPT_IN
         REPL EMPL_NO WITH EMP_IN
         REPL CONTRACT WITH CON_IN
         REPL HOURS WITH HOURS_IN
         @ ROW,COL SAY CON_IN
         @ ROW,COL+20 SAY HOURS_IN PICTURE '999.9'
         ROW=ROW+1
         CHG_FLAG=.T.
         IF ROW>20
            ROW=1
            COL=40
         ENDIF
         TOT_HOURS=TOT_HOURS+HOURS_IN
         DATA=.T.
      ENDDO
      @ 21,0 SAY 'TOTAL HOURS'
      @ 21,20 SAY TOT_HOURS PICTURE '999.9'
      ACCEPT ' Edit Timesheet (Y/N) ' TO REPLY
      REPLY=UPPER(REPLY)
      IF REPLY='Y'
         EMP_KEY=EMP_IN
         DO EDITEMPL
         CLEAR
         @ 1,0 SAY 'Time Sheet Data Entry'
         @ 2,0 SAY 'Department   '+DEPT_IN
         SELECT D
         SEEK DEPT_IN
         @ 2,40 SAY NAME
         SELECT A
      ENDIF
   ENDDO
ENDDO
IF CHG_FLAG
   SELECT E
   REPL VERIFY WITH .F.
ENDIF
SELECT A

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE REDO

TOT_HOURS=TOT_HOURS-HOURS
R_ROW=ROW-1
R_COL=COL
IF R_ROW<1
   R_COL=40
   R_ROW=20
ELSE
   R_COL=0
ENDIF
@ 5,0 SAY 'Contract (R) ' GET CONTRACT
@ 6,0 SAY 'Hours    (R) ' GET HOURS
READ
TOT_HOURS=TOT_HOURS+HOURS
@ R_ROW,R_COL SAY CONTRACT
@ R_ROW,R_COL+20 SAY HOURS PICTURE '999.9'

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE EDIT

SELECT A
EMP_KEY=' '
EDIT_LOOP=.T.
CHG_FLAG=.F.
DO WHILE EDIT_LOOP
   CLEAR
   EMP_KEY='    '
   @ 1,0 SAY 'Edit Time Sheet'
   @ 2,0 SAY 'Employee No. ' GET EMP_KEY
   @ 10,0 SAY 'WARNING:  If entries are added to the file while in'
   @ 11,0 SAY '          this edit mode, you must provide data for'
   @ 12,0 SAY '          all of the fields, i.e. EMPL_NO, DEPT.'
   @ 13,0 SAY '          Failure to provide the correct data in these'
   @ 14,0 SAY '          fields will result in the entry being lost.'
   READ
   IF EMP_KEY=' '
      EDIT_LOOP=.F.
      LOOP
   ENDIF
   DO EDITEMPL
ENDDO
IF CHG_FLAG
   SELECT E
   REPL VERIFY WITH .F.
ENDIF
SELECT A

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE EDITEMPL

SEEK EMP_KEY
IF EOF()
   @ 18,0 SAY 'Employee not found'
   WAIT
ELSE
   CHG_FLAG=.T.
   START=RECNO()
   IF CLIPPER
      DO BROW WITH 'EMPL_NO','DEPT','CONTRACT','HOURS'
   ELSE
      BROWSE FIELDS EMPL_NO,DEPT,CONTRACT,HOURS
   ENDIF
   GOTO START
   SUM HOURS TO TOT_HOURS WHILE EMPL_NO=EMP_KEY
   CLEAR
   ? 'Employee '+EMP_KEY+' Total = '
   ?? TOT_HOURS
   ?
   WAIT
ENDIF

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE VERIFY

CLEAR
TEXT
Verify program selected.

This verify program will compare the current time sheet input data
to the master files and print out an error report that lists those
entries that are bad and a message indicating which fields are at
fault.

The time sheet input data should be verified before any payroll reports
are printed. The Master Files can be updated, if necessary, and the
verify performed again.

8-1/2 x 11 inch paper can be used.

Check printer for paper alignment.

ENDTEXT
ACCEPT 'Continue with verify (Y/N) ' TO REPLY
REPLY=UPPER(REPLY)
IF REPLY#'Y'
   RETURN
ELSE
   ? 'Verifing......'
ENDIF
SELECT B
SET INDEX TO &TSSENMBR
SELECT A
ROW=99
ERR=0
SET DEVICE TO PRINT
DO WHILE .NOT. EOF()
   EMPL_KEY=EMPL_NO
   CON_KEY=SUBSTR(CONTRACT,1,7)
   DEPT_KEY=DEPT
   SELE B
   SEEK EMPL_KEY
   IF EOF()
      EMPL_FLAG=.T.
   ELSE
      EMPL_FLAG=.F.
   ENDIF
   SELE C
   SEEK CON_KEY
   IF EOF()
      CON_FLAG=.T.
   ELSE
      CON_FLAG=.F.
   ENDIF
   SELE D
   SEEK DEPT_KEY
   IF EOF()
      DEPT_FLAG=.T.
   ELSE
      DEPT_FLAG=.F.
   ENDIF
   SELE A
   IF EMPL_FLAG .OR. CON_FLAG .OR. DEPT_FLAG
      ERR=ERR+1
      IF ROW>60
         @ 0,0
         @ 1,0 SAY DTOC(DATE())
         @ 1,22 SAY 'TIME SHEET DATA VERIFY ERROR REPORT'
         @ 3,0 SAY 'NMBR'
         @ 3,6 SAY 'DEPT.'
         @ 3,15 SAY 'CONTRACT'
         @ 3,30 SAY 'REC'
         @ 3,40 SAY 'ERROR FIELD/DATA'
         ROW=5
      ENDIF
      @ ROW,0 SAY EMPL_NO
      @ ROW,6 SAY DEPT
      @ ROW,15 SAY CONTRACT
      @ ROW,30 SAY RECNO() PICT '9999'
      IF EMPL_FLAG
         @ ROW,40 SAY 'EMPL NO'
      ENDIF
      IF CON_FLAG
         @ ROW,50 SAY 'CONTRACT'
      ENDIF
      IF DEPT_FLAG
         @ ROW,60 SAY 'DEPT'
      ENDIF
      ROW=ROW+1
   ENDIF
   SKIP
ENDDO
SET DEVICE TO SCREEN
CLEAR
SELECT E
IF ERR=0
   ? 'No errors were found on any of the entries.'
   ? 'Nice going, Bernice !!!'
   REPL VERIFY WITH .T.
ELSE
   ? 'There are '+STR(ERR,3)+' entries that have errors.'
   ? 'Calm down, Bernice !!!'
   EJECT
   REPL VERIFY WITH .F.
ENDIF
SELECT B
SET INDEX TO &TSSENAME
GOTO TOP
?
WAIT
SELECT A

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE ARCHIVE

CLEAR
TEXT
Time Sheet Archive Routine has been selected.

The current time sheet data will be transferred to a backup file and
then the current time sheet data will be CLEARED OUT in preparation
for the next pay period.

ENDTEXT
ACCEPT 'Continue with program (Y/N) ' TO REPLY
REPLY=UPPER(REPLY)
IF REPLY#'Y'
   SELECT A
   RETURN
ELSE
   ?
   ? 'Archiving.......'
ENDIF

* files need to be closed before the COPY FILE command will work
*
CLOSE DATA
CLOSE INDEX
COPY FILE &TSSINPUT..DBF TO &TSSINPUT..DBK

* clear out input file
*
USE &TSSINPUT
ZAP
INDEX ON EMPL_NO TO &TSSINPUT

* update status file
*
USE &TSSSTAT
REPLACE VERIFY WITH .F.
USE

* re-open the system files
*
DO INITDBF

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE STATUS

CLEAR
SELECT E
TEXT
Time Sheet System Status :

Last Payroll Report      :
Last End of Month        :

ENDTEXT
@ 3,26 SAY PAY_REPT
@ 4,26 SAY EOM_PROC
@ 10,0
SELECT A
WAIT

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE REGEN

CLEAR
TEXT
Regenerate File Indexes.

This routine will remove all deleted entries that may be
invisible, but are still taking up space on the diskette.

The index files are regenerated to improve access speed.

This routine should be performed whenever the system seems
to have slowed down, or when the free space on the diskette
is getting low.

ENDTEXT
ACCEPT 'Continue with regeneration (Y/N) ' TO REPLY
REPLY=UPPER(REPLY)
IF REPLY#'Y'
   RETURN
ELSE
   ? 'Regenerating.....'
ENDIF

? 'Input'
SELECT A
PACK
INDEX ON EMPL_NO TO &TSSINPUT
GOTO TOP

? 'Employee'
SELECT B
PACK
INDEX ON LAST_NAME TO &TSSENAME
INDEX ON EMPL_NO TO &TSSENMBR
GOTO TOP

? 'Contract'
SELECT C
PACK
INDEX ON CONTRACT TO &TSSCONTR
GOTO TOP

? 'Department'
SELECT D
PACK
INDEX ON DEPT TO &TSSDEPT
GOTO TOP

? 'Report Control file'
SELECT F
PACK
INDEX ON CONTRACT TO &TSSRCTRL
GOTO TOP
SELECT A

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE MAINT

CLEAR
TEXT
Time sheet input data maintenance program.

To be used to clean-up the input data when special needs are required,
for example, deletion of records with blank employee numbers.

The data is presented by employee number order.

You may add records, however, you must provide data in all fields.

ENDTEXT
ACCEPT 'Continue with program (Y/N) ' TO REPLY
REPLY=UPPER(REPLY)
IF REPLY#'Y'
   RETURN
ENDIF
SELECT A
GOTO TOP
IF EOF()
   ? 'Input data file is empty...'
   WAIT
ELSE
   IF CLIPPER
      DO BROW WITH 'EMPL_NO','DEPT','CONTRACT','HOURS'
   ELSE
      BROWSE FIELDS EMPL_NO,DEPT,CONTRACT,HOURS
   ENDIF
ENDIF

RETURN
*
*****************************************************************************
*****************************************************************************
*
PROCEDURE REPTLIST

SELECT F
GOTO TOP
IF CLIPPER
   DO BROW WITH 'CONTRACT',' ',' ',' '
ELSE
   BROWSE FIELDS CONTRACT
ENDIF
COUNT ALL TO TEMP
CLEAR
MAX=INT(((P_WIDTH - 24)/7))
IF TEMP>MAX
   TEXT
   WARNING :

   There are too many contracts in the list.

   You should go back and delete the un-wanted contracts
   from the list before this gets out of hand.

   YOU HAVE BEEN WARNED !!!

   ENDTEXT
   ? 'A maximum of '
   ?? MAX
   ?? ' contract is allowed.'
ELSE
   ? 'There are '+STR(TEMP,2)+' contracts on the list.'
   ?
   ? 'You have a maximum of '
   ?? MAX
   ?? ' contracts.'
   ?
ENDIF
WAIT
SELECT A

RETURN
*
*****************************************************************************
*****************************************************************************
*
* Initialize and verify required files and indexes
* Index files are generated if not found.
*
PROCEDURE INITDBF

ERROR=.F.
ERR_LIST=' '
SELECT A
IF FILE('&TSSINPUT..DBF')
   IF .NOT. FILE('&TSSINPUT.&NDX')
      USE &TSSINPUT
      ? 'Generating TSSINPUT index file.'
      SET TALK ON
      INDEX ON EMPL_NO TO &TSSINPUT
      SET TALK OFF
   ENDIF
   USE &TSSINPUT INDEX &TSSINPUT
ELSE
   ERROR=.T.
   ERR_LIST=ERR_LIST+'&TSSINPUT '
ENDIF

SELECT B
IF FILE('&TSSEMPL..DBF')
   IF .NOT. FILE('&TSSENAME.&NDX')
      USE &TSSEMPL
      ? 'Generating TSSENAME index file.'
      SET TALK ON
      INDEX ON LAST_NAME TO &TSSENAME
      SET TALK OFF
   ENDIF
   IF .NOT. FILE('&TSSENMBR.&NDX')
      USE &TSSEMPL
      ? 'Generating TSSENMBR index file.'
      SET TALK ON
      INDEX ON EMPL_NO TO &TSSENMBR
      SET TALK OFF
   ENDIF
   USE &TSSEMPL INDEX &TSSENMBR
ELSE
   ERROR=.T.
   ERR_LIST=ERR_LIST+'&TSSEMPL '
ENDIF

SELECT C
IF FILE('&TSSCONTR..DBF')
   IF .NOT. FILE('&TSSCONTR.&NDX')
      USE &TSSCONTR
      ? 'Generating TSSCONTR index file.'
      SET TALK ON
      INDEX ON CONTRACT TO &TSSCONTR
      SET TALK OFF
   ENDIF
   USE &TSSCONTR INDEX &TSSCONTR
ELSE
   ERROR=.T.
   ERR_LIST=ERR_LIST+'&TSSCONTR '
ENDIF

SELECT D
IF FILE('&TSSDEPT..DBF')
   IF .NOT. FILE('&TSSDEPT.&NDX')
      USE &TSSDEPT
      ? 'Generating TSSDEPT index file.'
      SET TALK ON
      INDEX ON DEPT TO &TSSDEPT
      SET TALK OFF
   ENDIF
   USE &TSSDEPT INDEX &TSSDEPT
ELSE
   ERROR=.T.
   ERR_LIST=ERR_LIST+'&TSSDEPT '
ENDIF

SELECT E
IF FILE('&TSSSTAT..DBF')
   USE &TSSSTAT
ELSE
   ERROR=.T.
   ERR_LIST=ERR_LIST+'&TSSSTAT '
ENDIF

SELECT F
IF FILE('&TSSRCTRL..DBF')
   IF .NOT. FILE('&TSSRCTRL.&NDX')
      USE &TSSRCTRL
      ? 'Generating TSSRCTRL index file.'
      SET TALK ON
      INDEX ON CONTRACT TO &TSSRCTRL
      SET TALK OFF
   ENDIF
   USE &TSSRCTRL INDEX &TSSRCTRL
ELSE
   ERROR=.T.
   ERR_LIST=ERR_LIST+'&TSSRCTRL '
ENDIF

IF ERROR
   CLEAR
   TEXT
   The Time Sheet System database file requirements were not met.
   All of the files in the list below were either deleted from the
   disk or not transferred along with the other files.

   The following database files could not be verified:

   ENDTEXT
   ? ERR_LIST
   WAIT
ENDIF
SELECT A

RETURN
*
*****************************************************************************
*****************************************************************************
*
* sound bell, flash message, wait for key to be pressed
*
PROCEDURE WAITKEY

IF CLIPPER
   CM=30
ELSE
   CM=6
ENDIF
?? BELL
MSG=' PRESS <ENTER> TO CONTINUE '
KP=INKEY()  && FLUSH KEY BUFFER
KP=0
C=0
DO WHILE KP=0
   IF C>CM/2
      SET COLOR TO I
   ENDIF
   @ 1,40 SAY MSG
   SET COLOR TO
   KP=INKEY()
   C=C+1
   IF C>CM
      C=0
   ENDIF
ENDDO
@ 1,40 SAY SPACE(LEN(MSG))

RETURN
*
*****************************************************************************
*****************************************************************************
*
* END OF PROCEDURE FILE - TSSPROC.PRG
*
*****************************************************************************